HPAVC/HPAVC CD-ROM.iso/pc/PINBSRC.ZIP/_CDPLAYR.PAS

Pascal/Delphi Source File | 1996-02-02 | 8.4 KB | 276 lines

CONST StaText : array[-3..11] of string = (
                {erros}
                'CD changed',
                'No CD-DA! ',
                'No CD-ROM!',
                'Ready     ',
                {status}
                'Play      ',
                'Pause     ',
                'Stop      ',
                'Skip '+#16+'│   ',
                'Skip │'+#17+'   ',
                'Search '+#16+#16+' ',
                'Search '+#17+#17+' ',
                'Open Tray ',
                'Close Tray',
                'Un/Shuffle',
                'Introplay ');

VAR
  maxTitles : integer;
  Actual    : integer;
  status : integer;
  cdende : boolean;

  rr : char;

  timeinfo : QChannel_Info;

  oldtrack,oldtmin,oldtsec : byte;

function out(t1,t2:byte):string;
  var z : string;
begin
  z := '';
  if t1 < 10 then z := '0'+inttostr(t1) else z := inttostr(t1);
  z := z + ':';
  if t2 < 10 then z := z + '0'+inttostr(t2) else z := z + inttostr(t2);
  out := z;
end;

procedure CDROMStatus(t:integer);
  var a : byte;
begin
  Status := t;
  repeat led_anzeige; until led_status = 0;
  led_anzeige_5_init(3*8,0,StaText[t]);
  repeat led_anzeige; until led_status = 0;
end;

procedure TrackTyp;
  var z : string;
begin
  actual := Get_Actual_Track;
  if actual > maxTitles then begin
      Stop_audio_1;
      Play_Tracks(longint(1),longint(maxTitles));
      Stop_Audio_1;
      actual := Get_Actual_Track;
      CDROMStatus(3);
    end;
  if actual <> oldtrack then begin
      oldtrack := actual;
      z := '';
      if actual < 10 then z := z + '0';
      z := z + inttostr(actual) + '/';
      if maxtitles < 10 then z := z + '0';
      z := z + inttostr(maxTitles);
      led_anzeige_5_init(4*8,8,z);
      repeat led_anzeige; until led_status = 0;
    end;
  if Get_Track_Info(actual) = $40 then begin
      CDROMStatus(3); Stop_Audio_1; end;
end;

procedure Time;
begin
  read_qChannel(timeinfo);
  if (Audio_Busy <> 0) then
        begin
          with timeinfo do begin
            if tsec <> oldtsec then begin
                oldtsec := tsec;
                led_anzeige_5_init(15*8,8,out(tMin,tSec));
                repeat led_anzeige; until led_status = 0;
    {            write('Total Time: '); out(dMin,dSec);}
              end;
          end;
        end else if (status = 3) or (status = 0) then
        begin
          with timeinfo do begin
            if tsec <> oldtsec then begin
                oldtsec := tsec;
                led_anzeige_5_init(15*8,8,'00:00');
                repeat led_anzeige; until led_status = 0;
    {            write('Total Time: 00:00');}
              end;
          end;
        end;
end;

procedure ResetMenu;
begin
  led_anzeige_5_init(0, 0,'CD:             >__<');
  repeat led_anzeige until led_status = 0;
  led_anzeige_5_init(0, 8,'No.:00/00 Time:00:00');
  repeat led_anzeige until led_status = 0;
end;

procedure Init;
  var rr : byte;
      k : char;
begin
oldtrack := 255; oldtmin := 255; oldtsec := 255;
resetmenu; cdende := false;
k := #0;
  repeat
    maxTitles := Init_CDAudio;
    if maxTitles < 0 then CDROMStatus(maxTitles);
    if keypressed then begin
                       case upcase(readkey) of
                         #27,'Q' : begin cdende := true; exit; end;
                         'C' : begin CDROMStatus(9); Insert_CD; end;
                         'P' : begin k := 'P';
                                     CDROMStatus(1); Insert_CD; end;
                         'O' : begin CDROMStatus(8); Eject_CD;end;
                       end;
                     end;
  until maxTitles > 0;
  actual := Get_Actual_Track;
  CDROMStatus(0);
  if audio_busy <> 0 then k := 'P';
  if Audio_Pause = 0 then begin
      if k = 'P' then begin
          rr := 1;
          repeat
            Play_Tracks(longint(rr),longint(maxTitles));
            inc(rr);
          until (rr > maxTitles) or (Audio_Busy <>0);
          CDROMStatus(1);
        end else begin
           Play_Tracks(longint(1),longint(maxTitles));
           Stop_Audio_1;
           CDROMStatus(3);
         end;
    end else CDROMStatus(2);
  cdende := false; actual := 0;
  TrackTyp;

actual := 1;
end;

procedure CDPLayer;

{begin of HP}
  label start;

  var t : array[0..1] of char;
      p : byte;
      check : integer;
      alt : byte;

begin
start:
  p := 0; t[0] := '_'; t[1] := '_';
  Init; if cdende then exit;
  repeat
    Time;
    TrackTyp;
    if (Status = 1 {play}) and (Audio_Busy = 0) then
       begin CDROMStatus(status); rr := #0; CD_Reset; goto start; end;
(*    if (Status = 2 {pause}) and (Audio_Pause = 0) then
       begin CD_Reset; screenmask; goto start; end;*)
    rr := #0;
    if keypressed then rr := upcase(readkey);
    case rr of
        '+' : begin
                CDROMStatus(6); Skip_Audio(15*75);
                CDROMStatus(1);
              end;
        '-' : begin
                CDROMStatus(7); Skip_Audio(-15*75);
                CDROMStatus(1);
              end;
        'K' : begin
                CDROMStatus(5);
                dec(actual); if actual < 1 then actual := maxTitles;
                Stop_Audio_1;
                Play_Tracks(longint(actual), longint(maxTitles));
                CDROMStatus(1);
              end;
        'M' : begin
                CDROMStatus(4);
                inc(actual); if actual > maxTitles then actual := 1;
                Stop_Audio_1;
                Play_Tracks(longint(actual), longint(maxTitles));
                CDROMStatus(1);
              end;
        'P' : IF (Audio_Busy <> 0) THEN begin
                       CDROMStatus(2);
                       Stop_Audio_1
                     end else begin
                       CDROMStatus(1);
                       Resume_Audio_1;
                     end;
        'S' : {IF (Audio_Busy <> 0) THEN} begin
                      read_qChannel(timeinfo);
                      Skip_Audio(-timeinfo.tmin*4500
                                 -timeinfo.tsec*75
                                 -timeinfo.tframe);
                       CDROMStatus(3);
                       Stop_Audio_1;
                    end;
        'O' : begin CDROMStatus(8); Eject_CD; goto start; end;
        'C' : begin CDROMStatus(9); Insert_CD; end;
        #8 : begin t[0] := '_'; t[1] := '_';
                     led_anzeige_5_init(17*8,0,t[0]+t[1]);
                     repeat led_anzeige; until led_status = 0;
                     p := 0;
               end;
        '0'..'9',#13 : begin
                     t[1] := '_';
                     t[p] := rr;
                     if (rr = #13) and (p=1) then begin
                         t[1] := t[0]; t[0] := '0';
                       end else if rr = #13 then rr := #0;
                     if rr <> #0 then begin
                         inc(p);
                         if p = 2 then begin
                             val(t[0]+t[1],p,check);
                             if (p < 1) or (p > maxTitles) then
                               begin t[0] := '_'; t[1] := '_'; end
                               else begin Stop_Audio_1;
                                 CDROMStatus(1);
                                 Play_Tracks(longint(p),
                                             longint(maxTitles));
                               end;
                             p := 0;
                           end;
                         led_anzeige_5_init(17*8,0,t[0]+t[1]);
                         repeat led_anzeige; until led_status = 0;
                     end;
                   end;
      end;
  until (rr = #27) or (rr = 'Q');
END;

procedure StartCDPLayer;
  var b : word;
begin
  for b := CurrentPos to 400 do begin
      retrace; setlinecomp(b); end;
  ResetMenu;
  case VideoMode of
    '2' : CurrentPos := 332;
    '0' : CurrentPos := 332;
    '3' : CurrentPos := 366;
    '1' : CurrentPos := 366;
  end;
  for b := 400 downto CurrentPos do begin
      retrace; setlinecomp(b); end;
  CDPlayer;
  for b := CurrentPos to 400 do begin
      retrace; setlinecomp(b); end;
  CurrentPos := 400;
  led_anzeige_5_init(0,0,'Continue playing ...');
  repeat led_anzeige until led_status = 0;
  led_anzeige_5_init(0,8,'                    ');
  repeat led_anzeige until led_status = 0;
  for b := 400 downto NormalPos do begin
      retrace; setlinecomp(b); end;
  currentpos := normalpos;
end;